perm filename COORDS.F4[PUR,LCS] blob
sn#396830 filedate 1979-07-23 generic text, type T, neo UTF8
00100 COMMON J(512),K(3),JJ(21),M
00110 TYPE 1000
00120 1000 FORMAT(' FILE NAME (NO EXT.) -- '$)
00130 1001 FORMAT(A5)
00140 ACCEPT 1001,NAME
00200 TYPE 1
00300 1 FORMAT(' TO DSK? TYPE Y OR N'/)
00400 ACCEPT 11,L
00500 M=5
00600 IF(L.NE.'Y')GO TO 3
00700 M=1
00800 TYPE 2
00900 2 FORMAT(' WRITING FILE FOR01.DAT'/)
01000 3 CALL GETFILE(NAME)
01100 CALL FASTIN(JJ,21 )
01200 11 FORMAT(A1)
01300 10 FORMAT(10I8,/I4,/2X,10(3XA5))
01400 WRITE(M,10),JJ
01500 N=JJ(11)
01600 C WD CNT
01700 CALL FASTIN(J,N)
01800 CALL RDRAW(1,J(1),J)
01900 END
02000
02100 SUBROUTINE RDRAW(I,JA,IJ)
02200 COMMON J(512),K(3),JJ(21),M
02300 DIMENSION IJ(1)
02400 I=1
02500 WRITE(M,4),JJ(1)
02600 DO 3 KK=1,10
02700 KA=0
02800 JA=JJ(KK)
02900 DO 2 L=I,JA
03000 CALL UNPACK(L,IA,IB,J)
03100 KA=KA+1
03200 IF(L.NE.JA)GO TO 2
03300 KA=0
03400 WRITE(M,4),JJ(KK+11)
03500 2 WRITE(M,10),KA,IA,IB,J(L)
03600 3 I=JA+1
03700 4 FORMAT(/1XA5)
03800 10 FORMAT(4I)
03900 END
04000 SUBROUTINE UNPACK(K,M,N,I)
04100 COMMON/LL/L
04200 C L IS FOR VIS. OR INVIS. LINES.
04300 DIMENSION I(1)
04400 N=I(K)
04500 L=0
04600 IF(N.LT.100000000)GO TO 2
04700 L=(N/100000000)*100000000
04800 N=N-L
04900 2 M=N/10000
05000 N=N-M*10000
05100 IF(M.GT.1000)M=1000-M
05200 IF(N.GT.1000)N=1000-N
05300 END